#!/usr/bin/perl -w
#
# Classify bounces that arrive at the Linux Counter
# This program sorts them into categories and renames their
# files by class:
# - in.nnn - treated by this program
# - warning.nnn - warnings
# - tempfail.nnn - temporary failures
# - permfail.nnn - permanent failures
# - message.nnn - messages from a human (or something acting like one)
# 
# What we're not sure of is left as "in".
#
use strict;

use Mail::BounceParser;
use Getopt::Long;

use vars qw($parser $tempdir $DEBUG $verbose);
$DEBUG = 0;
$tempdir = "/home/counter/email/temp";

GetOptions("debug!" => \$DEBUG,
	   "verbose" => \$verbose);

$verbose = $verbose || $DEBUG;
if (! -d $tempdir) {
    warn "Using tempdir /tmp\n";
    $tempdir = "/tmp";
}

$parser = new Mail::BounceParser;

$parser->output_dir($tempdir);
$parser->output_to_core(20000); # 20 Kbytes incore, else swap

my $file;
while ($ARGV[0] =~ /^-/) {
    my $opt = shift;
    if ($opt eq "-d") {
	++ $Mail::Bounce::Heuristic::DEBUG;
	++ $Mail::Bounce::DEBUG;
    }
}

for $file (@ARGV) {

    $DEBUG && print "Reading $file\n";
    # Because most parts don't have content-lengths, we have to
    # fiddle with the output_to_core based on length...
    -e $file || die "No such file as $file\n";
    if (-s $file > 100000) { # 100 Kbytes
	$DEBUG && warn "$file: Big - doing files\n";
	$parser->output_to_core(20000);
    } else {
	#print STDERR "Doing incore\n";
	$parser->output_to_core("ALL");
    }
    open(FILE, $file) || die "Unable to open $file\n";
    my $classification;
    eval {
	my $msg = $parser->read(\*FILE) || die "$file: ERR:Parsing msg failed\n";
	$verbose && print "$file is a ", ref($msg), "\n";
	if (!$msg->isbounce()) {
	    print "$file is not a bounce\n";
	    $classification = "message";
	} elsif ($msg->recipients() > 1) {
	    print "$file has multiple recipients\n";
	    $classification = "multiple";
	} elsif ($msg->recipients() < 1) {
	    print "$file ERR: has no recipients\n";
	    $classification = "strange";
	} else {
	    my @recips = $msg->recipients();
	    my $recip = $recips[0];
	    $classification = $recip->type();
	    $classification = "strange" if $classification eq "<no type>";
	    $verbose && print "$file: Recipient is ", $recip->final_recipient(), "\n";
	}
    };
    if ($@) {
	$verbose && print "$file: Parse error: $@";
	$classification = "strange";
    }
    if ($classification) {
	print "$file: Classified as a $classification\n";
	if ($file =~ /([a-z<> ]+)\.\d+\.\d+$/) {
	    my $newfile;
	    ($newfile = $file) =~ s/$1/$classification/;
	    if ($newfile eq $file) {
		$verbose && print "Classification unchanged\n";
	    } else {
		while (-f $newfile) {
		    print "Name collision: $newfile already exists\n";
		    $newfile =~ s/(\d+)$/$1+1/e;
		    print "New name: $newfile\n";
		}
		$verbose && print "rename($file, $newfile)\n";
		rename($file, $newfile)
		    || die "Rename $file->$newfile failed\n";
	    }
	} else {
	    warn "$file: Don't recognize filename pattern\n";
	}
    } else {
	print "$file: Not understood\n";
    }
}
